Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/Libraries/PNL Libraries/MyLogs.p

Text File | 1995-03-13 | 4KB | 174 lines

unit MyLogs;

interface

    uses
        BaseLogs,Files;

    var
        log_fs:FSSpec;
        log_rn:integer;

    procedure InitLogs(keepopen,flush:boolean);
    procedure InitLogsFS(keepopen,flush:boolean; fs:FSSpec);
    procedure FinishLogs;
    procedure LogRaw (s: str255);
    procedure Log (l: LogStrings);
    procedure Log3 (l: LogStrings; s1, s2, s3: str255);
    procedure LogTime (l: LogStrings; s3: Str255);
    procedure LogFS (l: LogStrings; fs: FSSpec; s2, s3: str255);
    function ErrorTrailer (err: OSErr): Str255;

implementation

    uses
        Errors,TextUtils,MyTypes,Files,Folders,Aliases,MyStrH,MyStrings,MyUtils,MyFileSystemUtils;

    const
        log_text_creator='R*ch';

    var
        gKeepOpen:boolean;
        gFlush:boolean;

    procedure StartLog;
        var
            err: OSErr;
    begin
        if log_rn = bad_rn then begin
            err := FSpCreate(log_fs, log_text_creator, 'TEXT', -1);
            err := FSpOpenDF(log_fs, fsWrPerm, log_rn);
            if err <> noErr then begin
                log_rn := bad_rn;
            end else begin
                err := SetFPos(log_rn, fsFromLEOF, 0);
            end;
        end;
    end;

    procedure StopLog;
        var
            err: OSErr;
    begin
        if log_rn <> bad_rn then begin
            err := FSClose(log_rn);
            log_rn := bad_rn;
        end;
    end;

    procedure JointInit(keepopen,flush:boolean);
        var
            junk:OSErr;
            isfolder, wasalias:boolean;
    begin
        log_rn:=bad_rn;
        if GetIndStr(log_strh_id,ord(LS_Last))<>'<LAST>' then begin
            DebugStr('MyLogs:Log LS_Last is not <LAST>');
        end;
        gKeepOpen:=keepopen;
        gFlush:=flush;
        junk := ResolveAliasFile(log_fs, true, isfolder, wasalias);
        if gKeepOpen then begin
            StartLog;
        end;
    end;

    procedure InitLogs(keepopen,flush:boolean);
        var
            junk:OSErr;
    begin
        junk :=FindFolder(kOnSystemDisk,kPreferencesFolderType,true,log_fs.vRefNum,log_fs.parID);
        junk := FSMakeFSSpec(log_fs.vRefNum,log_fs.parID, GetIndStr(log_strh_id,ord(LS_Filename)), log_fs);
        JointInit(keepopen,flush);
    end;

    procedure InitLogsFS(keepopen,flush:boolean; fs:FSSpec);
    begin
        log_fs:=fs;
        JointInit(keepopen,flush);
    end;

    procedure FinishLogs;
    begin
        StopLog;
    end;

    procedure LogRaw (s: str255);
        var
            count: longInt;
            err: OSErr;
            pb: paramBlockRec;
    begin
        StartLog;
        if log_rn <> bad_rn then begin
            s := concat(s, cr);
            count := length(s);
            err := FSWrite(log_rn, count, @s[1]);

            if not gKeepOpen then begin
                StopLog;
            end else if gFlush then begin
                pb.ioRefNum := log_rn;
                err := PBFlushFileSync(@pb);
            end;
            if gFlush then begin
                pb.ioNamePtr := nil;
                pb.iovRefNum := log_fs.vRefnum;
                err := PBFlushVolSync(@pb);
            end;
        end;
    end;

    function ErrorTrailer (err: OSErr): Str255;
        var
            s: Str255;
    begin
        if err = noErr then begin
            s := '';
        end
        else begin
            SPrintS3(s, GetIndStr(log_strh_id, ord(LS_ErrorTrailer)), '', '', NumToStr(err));
        end;
        ErrorTrailer := s;
    end;

    procedure Log (l: LogStrings);
    begin
        LogRaw(GetIndStr(log_strh_id, ord(l)));
    end;

    procedure Log3 (l: LogStrings; s1, s2, s3: str255);
        var
            s: str255;
    begin
        SPrintS3(s, GetIndStr(log_strh_id, ord(l)), s1, s2, s3);
        LogRaw(s);
    end;

    procedure LogTime (l: LogStrings; s3: Str255);
        var
            s1, s2: str255;
            date: longInt;
    begin
        GetDateTime(date);
        IUDateString(date, shortDate, s1);
        IUTimeString(date, false, s2);
        Log3(l, s1, s2, s3);
    end;

    procedure LogFS (l: LogStrings; fs: FSSpec; s2, s3: str255);
        var
            s: str255;
            err: OSErr;
    begin
        err := FSSpecToFullpath(fs, s);
        if err = fnfErr then begin
            err := noErr;
        end;
        if err <> noErr then begin
            s := concat('???:', fs.name);
        end;
        Log3(l, s, s2, s3);
    end;

end.